module Language.ASTExpr.ParserPretty where

import Language.ASTExpr.Syntax

import Text.ParserCombinators.Parsec
import Text.ParserCombinators.Parsec.Token
import Text.ParserCombinators.Parsec.Pos
import Text.ParserCombinators.Parsec.Expr

--fromString :: String -> Either String Expr
--fromString s = either (Left . show) (Right) $ parse expr "user_input" s

dummySpan :: SourceSpan
dummySpan = SrcSpan (newPos "not_parsed" (-1) (-1)) (newPos "not_parsed" (-1) (-1))

expr    :: Parser Expr
expr    =   try letExpr
        <|> buildExpressionParser eTable factor
        <?> "expression"

eTable   = [[op "*"  mkMul  AssocLeft]
           ,[op "+"  mkAdd  AssocLeft]
           ]          
        where
          op s f assoc
             = Infix (do{ many space; string s; many space; return f}) assoc


letExpr = do { many space
             ; srcFrom <- getPosition
             ; string "let"
             ; many space
             ; decl <- declaration
             ; many space
             ; string "in"
             ; many space
             ; exp <- expr
             ; srcTo <- getPosition
             ; many space
             ; return (Let (SrcSpan srcFrom srcTo) decl exp )
             }

declaration = seqDecl <|> varDecl <|> do { return (None dummySpan) }

varDecl = do { many space
             ; srcFrom <- getPosition
             ; var <- letter
             ; many space
             ; string ":="
             ; many space
             ; exp <- expr
             ; srcTo <- getPosition
             ; many space
             ; return ((:=) (SrcSpan srcFrom srcTo) var exp)
             }

seqDecl = do { many space
             ; srcFrom <- getPosition
             ; char '['
             ; many space
             ; decl1 <- declaration
             ; many space
             ; char ','
             ; many space
             ; decl2 <- declaration
             ; many space
             ; char ']'
             ; srcTo <- getPosition
             ; many space
             ; return (Seq (SrcSpan srcFrom srcTo) decl1 decl2 )
             }


factor  = do{ many space
            ; char '('
            ; many space
            ; x <- expr
            ; many space
            ; char ')'
            ; many space
            ; return x 
            }
        <|> number
        <|> variable
        <?> "simple expression"

number  :: Parser Expr
number  = do{ many space
            ; srcFrom <- getPosition
            ; ds <- many1 digit
            ; srcTo <- getPosition
            ; many space
            ; return (Const (SrcSpan srcFrom srcTo) (read ds))
            }
        <?> "number"

variable :: Parser Expr
variable = do { many space
              ; srcFrom <- getPosition
              ; varName <- letter
              ; srcTo <- getPosition
              ; many space
              ; return (EVar (SrcSpan srcFrom srcTo) varName)
              }
          <?> "variable"


mkAdd :: Expr -> Expr -> Expr
mkAdd x y = (Add (mkExprSrcSpan x y) x y )

mkMul :: Expr -> Expr -> Expr
mkMul x y = (Mul (mkExprSrcSpan x y) x y )

mkExprSrcSpan :: Expr -> Expr -> SourceSpan
mkExprSrcSpan e1 e2 = (SrcSpan (srcFrom $ getExprSrcSpan e1) (srcTo $ getExprSrcSpan e2) )

getExprSrcSpan :: Expr -> SourceSpan
getExprSrcSpan (Const srcSpan _) = srcSpan
getExprSrcSpan (EVar srcSpan _)  = srcSpan
getExprSrcSpan (Add srcSpan _ _) = srcSpan
getExprSrcSpan (Mul srcSpan _ _) = srcSpan
getExprSrcSpan (Let srcSpan _ _) = srcSpan
getExprSrcSpan (Neg srcSpan _)   = srcSpan

getDeclSrcSpan :: Decl -> SourceSpan
getDeclSrcSpan ((:=) srcSpan _ _) = srcSpan
getDeclSrcSpan (Seq srcSpan _ _)  = srcSpan
getDeclSrcSpan _                  = dummySpan

